home *** CD-ROM | disk | FTP | other *** search
/ A.C.E. 2 / ACE CD 2.iso / FILES / UTILS / HSBASIC2.DMS / in.adf / HB2Examples1.3.Lha / Examples / IFF_8SVX / iff_8svx.bas < prev    next >
Encoding:
BASIC Source File  |  1994-04-29  |  8.4 KB  |  339 lines
  1. DEFINT A-Z
  2. 'REM $INCLUDE Exec.bh
  3. 'REM $INCLUDE Audio.bc
  4. 'REM $INCLUDE IFFParse.bh
  5. 'REM $INCLUDE utility.bc
  6. 'REM $INCLUDE DOS.bh
  7. 'REM $INCLUDE graphics.bh
  8. 'REM $INCLUDE datatypes/Soundclass.bc
  9. 'REM $INCLUDE datatypes/Pictureclass.bc
  10. 'REM $INCLUDE asl.bh
  11.  
  12. REM $INCLUDE Blib/ExecSupport.bas
  13. REM $INCLUDE BLib/IFFBufIO.bas
  14.  
  15. CONST ID_CHAN& = &h4248414E
  16. CONST NTSC_CLOCK& = 3579545&
  17. CONST PAL_CLOCK& = 3546895&
  18. CONST AIOCNT = 2
  19. CONST MAXSAMPLE&= &h20000&
  20. '
  21. 'Ask the system if we are PAL or NTSC and set clock constant accordingly 
  22. '
  23. FUNCTION getAudioClock&
  24.     STATIC GfxBase&, palflag
  25.  
  26.     getAudioClock& = -1&
  27.     palflag = PAL&
  28.     IF PEEKW(LIBRARY("graphics.library") + lib_Version) >= 39 THEN
  29.         'V39 and above have an early-start independent PAL detection method
  30.  
  31.         palflag = REALLY_PAL&
  32.     END IF
  33.     IF PEEKW(LIBRARY("graphics.library") + DisplayFlags) AND palflag THEN
  34.         getAudioClock& = PAL_CLOCK&
  35.     ELSE
  36.         getAudioClock& = NTSC_CLOCK&
  37.     END IF
  38. END FUNCTION
  39. '
  40. 'Set up the audio I/O block for channel allocation
  41. '
  42. SUB allocateAudioChannels(BYVAL audioIO&, BYVAL audioMP&)
  43.     STATIC ioreq&, whichannel&
  44.  
  45.     ioreq& = audioIO& + ioa_Request
  46.  
  47.     POKEL ioreq& + IORequestio_Message + mn_ReplyPort, audioMP&    ' the address of a reply port
  48.     POKEB ioreq& + IORequestio_Message + mn_Node + ln_Pri, 0    ' neutral priority
  49.     POKEW ioreq& + IORequestio_Command, ADCMD_ALLOCATE&        ' allocate the channels
  50.     POKEB ioreq& + IORequestio_Flags, ADIOF_NOWAIT&
  51.  
  52.     POKEW audioIO& + ioa_AllocKey, 0
  53.  
  54.     whichannel& = &h01020408    ' channel allocation
  55.     POKEL audioIO& + ioa_Data, VARPTR(whichannel&)
  56.     POKEL audioIO& + ioa_Length, 4
  57. END SUB
  58.  
  59.  
  60. SUB OpenAudio
  61. DIM SHARED devopened, port&
  62. STATIC k
  63. STATIC device&
  64. SHARED tclock&
  65. IF devopened THEN EXIT SUB
  66.  
  67. tclock&=getAudioClock&
  68. DIM SHARED  aio&(AIOCNT)
  69.  
  70.  
  71. '
  72. 'Create a reply port so the audio device can reply to our commands
  73. '
  74. port& = CreatePort&(NULL&, 0)
  75. IF port& THEN
  76.     FOR k=0 TO AIOCNT-1
  77.         aio&(k)=CreateExtIO&(port&,IOAudio_sizeof)
  78.         IF aio&(k)=0 THEN CALL CloseAudio: EXIT SUB
  79.     NEXT k
  80.     allocateAudioChannels aio&(0),port&
  81.     device& = OpenDevice&(SADD("audio.device" + CHR$(0)), 0, aio&(0), 0)
  82. ' Clone the flags, channel allocation, etc. into other IOAudio requests
  83.     FOR k=1 TO AIOCNT-1
  84.         CopyMem aio&(0),aio&(k),IOaudio_sizeof
  85.     NEXT k
  86. END IF
  87. IF device&=0 THEN devopened=-1 ELSE CALL CloseAudio
  88. END SUB
  89.  
  90.  
  91. '
  92. ' Close audio device as opened by OpenAudio, null out pointers
  93. ' 
  94. SUB CloseAudio
  95. STATIC k
  96. SHARED devopened,port&
  97. ' Note - we know we have no outstanding audio requests */
  98. IF devopened THEN
  99.     CloseDevice aio&(0)
  100.     devopened = 0
  101. END IF
  102. FOR k=0 TO AIOCNT-1
  103.     IF aio&(k) THEN
  104.         DeleteExtIO aio&(k)
  105.         aio&(k) = NULL&
  106.     END IF
  107. NEXT k
  108. IF port& THEN
  109.     DeletePort port&
  110.     port& = NULL&
  111. END IF
  112. END SUB
  113.  
  114.  
  115. FUNCTION LoadSBody(BYVAL iff&,BYVAL vhdr&)
  116. SHARED sbytes&
  117. SHARED sample&
  118. STATIC memtype&
  119. STATIC compression
  120. STATIC cn&
  121.     LoadSBody=0
  122.     cn&=CurrentChunk(iff&)
  123.     IF PEEKL(cn&+cn_type)<>ID_8SVX& OR PEEKL(cn&+cn_ID)<>ID_BODY& THEN
  124.         PRINT "couldn't find BODY chunk"
  125.         EXIT FUNCTION
  126.     END IF
  127.     sbytes& = PEEKL(cn&+cn_Size) - PEEK(cn&+cn_Scan)
  128.     ' if we have to decompress, let's just load it into public mem
  129.     compression= PEEKB(vhdr&+vh_Compression)
  130.     IF compression THEN
  131.         memtype&= MEMF_PUBLIC&
  132.     ELSE
  133.         memtype&= MEMF_CHIP&
  134.     END IF
  135.     sample&=AllocMem(sbytes&,memtype&)
  136.     IF sample&=0 THEN
  137.         PRINT "Not enough memory"
  138.         EXIT FUNCTION
  139.     END IF
  140.     IF ReadChunkBytes(iff&,sample&,sbytes&)<>sbytes& THEN
  141.         PRINT "Can't read whole sample"
  142.         EXIT FUNCTION
  143.     END IF
  144.     
  145.     SELECT CASE compression
  146.     CASE 0
  147.     CASE CMP_FIBDELTA&
  148.         PRINT "Delta compression not yet implemented"
  149.         EXIT FUNCTION
  150.     CASE ELSE
  151.         PRINT "Unknown compression method:";compression
  152.     END SELECT    
  153.     LoadSBody=-1
  154. END FUNCTION
  155.  
  156. SUB UnloadSBody
  157. SHARED sample&, sbytes& 
  158.     IF sample& THEN
  159.         FreeMem sample&,sbytes&
  160.         sample&=0
  161.     END IF
  162.     sbytes&=0
  163. END SUB
  164.  
  165. '
  166. 'The main play sample routine
  167. '
  168. SUB PlaySample(BYVAL vhdr&)
  169. SHARED aio&(1),tclock&
  170. SHARED sbytes&,sample&
  171. STATIC ioreq&,a&,junk&
  172. STATIC period,volume
  173. STATIC req        ' the index of the Audio Request that is currently playing
  174. STATIC reqn        ' the index of the next request that we are creating
  175. STATIC sampleptr&    ' where we are playing from
  176. STATIC bytesleft&    ' bytes still to play
  177.  
  178.     period= tclock&/PEEKW(vhdr&+vh_samplespersec)
  179.     volume=MAX(PEEKL(vhdr&+vh_volume)*64/&h10000,64)
  180.  
  181.     sampleptr&=sample&
  182.     bytesleft&=sbytes&    
  183.  
  184.     a&=aio&(0)
  185.     ioreq&=a&+ioa_Request
  186.  
  187.     POKEW ioreq& + IORequestio_Command    , CMD_WRITE&
  188.     POKEB ioreq& + IORequestio_Flags    , ADIOF_PERVOL&
  189.     POKEL a&     + ioa_Data                , sampleptr&
  190.     POKEL a&     + ioa_Length            , MIN(bytesleft&, MAXSAMPLE&)
  191.     POKEW a&     + ioa_Period            , period
  192.     POKEW a&     + ioa_Volume             , volume
  193.     POKEW a&     + ioa_Cycles            , 1
  194.  
  195. ' Send the command to start a sound using BeginIO()
  196.     BEGINIO a&
  197.     req=0            ' the first one is now playing
  198.  
  199.     DO
  200.         bytesleft&=bytesleft&-MAXSAMPLE&
  201.         IF bytesleft&<=0 THEN EXIT LOOP
  202.         sampleptr&=sampleptr&+MAXSAMPLE&
  203.  
  204.         reqn = req XOR 1        ' alternate IO Blocks 0 and 1
  205.         a&=aio&(reqn)
  206.         ioreq&=a&+ ioa_Request
  207.  
  208.         POKEW ioreq& + IORequestio_Command    , CMD_WRITE&
  209.         POKEB ioreq& + IORequestio_Flags    , ADIOF_PERVOL&
  210.         POKEL a&     + ioa_Data                , sampleptr&
  211.         POKEL a&     + ioa_Length            , MIN(bytesleft&,MAXSAMPLE&)
  212.         POKEW a&     + ioa_Period            , period
  213.         POKEW a&     + ioa_Volume             , volume
  214.         POKEW a&     + ioa_Cycles            , 1
  215.         BEGINIO a&
  216.  
  217.         junk&= WaitIO(aio&(req))        ' wait for the previous request to finish
  218.  
  219.         req    =reqn            ' the one we've just started is now playing
  220.         
  221.     LOOP    
  222. ' wait for the final (or only!) io request to finish        
  223.     junk&= WaitIO(aio&(req))
  224.  
  225. PRINT "done!"
  226. END SUB
  227.  
  228.  
  229.  
  230. SUB PlayFile (filename$)
  231. STATIC iff&, stream&, junk&, sp&, vhdr&, camg&, bm&, screenptr&, w, h, depth
  232. SHARED sbytes&
  233. iff& = AllocIFF&
  234. IF iff& THEN
  235.     stream& = xOpen&(SADD(filename$ + CHR$(0)), MODE_OLDFILE&)
  236.     IF stream& THEN
  237.         POKEL iff& + iff_Stream, stream&        'connect the DOS stream
  238.  
  239.         IF PEEKW(LIBRARY("dos.library") + lib_Version) >= 36 THEN
  240.         'for WB2 and above, use the buffered DOS I/O calls
  241.             junk& = SetVBuf&(stream&, NULL&, BUF_FULL&, 8192)
  242.             initIFFasBufferedDOS iff&
  243.         ELSE
  244.         'fall back for 1.3 (if you have 1.3 iffparse.library)
  245.             InitIFFasDos iff&
  246.         END IF
  247.  
  248.         IF OpenIFF&(iff&, IFFF_READ&) = 0 THEN
  249.             IF PropChunk&(iff&, ID_8SVX&, ID_VHDR&) = 0 AND _
  250.               StopChunk&(iff&, ID_8SVX&, ID_BODY&) = 0 AND _
  251.               ParseIFF(iff&, IFFPARSE_SCAN&) = 0 THEN
  252.  
  253.                 'look for a VHDR stored property
  254.                 sp& = FindProp&(iff&, ID_8SVX&, ID_VHDR&)
  255.                 vhdr& = 0
  256.                 IF sp& THEN    vhdr& = PEEKL(sp& + sp_Data)
  257.                 IF vhdr& THEN
  258.                     PRINT "VHDR info:"
  259.                     PRINT "oneShotHiSamples = ", PEEKL(vhdr&+vh_oneShotHiSamples)
  260.                     PRINT "repeatHiSamples = ", PEEKL(vhdr&+vh_repeatHiSamples) 
  261.                     PRINT "samplesPerHiCycle = ", PEEKL(vhdr&+vh_samplesPerHiCycle)
  262.                     PRINT "samplesPerSec = ", PEEKW(vhdr&+vh_samplesPerSec)
  263.                     PRINT "Octaves = ", PEEKB(vhdr&+vh_Octaves)
  264.                     PRINT "Compression = ", PEEKB(vhdr&+vh_Compression)
  265.                     PRINT "volume = ", HEX$(PEEKL(vhdr&+vh_volume))
  266.                     IF PEEKB(vhdr&+vh_octaves)=1 AND _ 
  267.                         PEEKW(vhdr&+vh_samplesPerSec)<>0 AND _
  268.                         PEEKL(Vhdr&+vh_oneShotHiSamples)<>0 AND _
  269.                         PEEKL(Vhdr&+vh_repeatHiSamples)=0 THEN
  270.                     ' its a simple sampled sound rather than a musical instrument
  271.                         IF LoadSBody(iff&,vhdr&) THEN
  272.                             PRINT "loaded";sbytes&; "bytes of sample"
  273.                             PlaySample vhdr&
  274.                         END IF
  275.                         UnLoadSBody    ' we must call this even if we failed to load
  276.                     ELSE
  277.                         PRINT "Its not a simple sound"
  278.                     END IF
  279.                 ELSE
  280.                     PRINT "No VHDR"
  281.                 END IF
  282.             ELSE
  283.                 PRINT "Can't find VHDR and/or BODY"
  284.             END IF
  285.             
  286.             CloseIFF iff&
  287.             junk& = xClose(PEEKL(iff& + iff_Stream))
  288.             FreeIFF iff&
  289.         END IF
  290.     ELSE
  291.         PRINT filename$;" not found"
  292.     END IF
  293. END IF
  294. END SUB
  295.  
  296. '
  297. ' Start the main program
  298. '
  299. LIBRARY OPEN "dos.library"
  300. LIBRARY OPEN "graphics.library"
  301. LIBRARY OPEN "iffparse.library"
  302. LIBRARY OPEN "exec.library"
  303.  
  304. OpenAudio
  305. IF devopened=0 THEN PRINT "Can't open audio":STOP
  306.  
  307. IF LEN(COMMAND$) then
  308.     ' we have a command line - play the file
  309.         PlayFile COMMAND$ 
  310. ELSE
  311. ' No command line use the ASL file requester (only works on WB2 and up)
  312.     LIBRARY OPEN "asl.library"
  313.     DIM frtags&(20)
  314.     TAGLIST VARPTR(frtags&(0)),ASLFR_TitleText&,"Sound Sample Info", _
  315.             ASLFR_InitialFile&,"", _
  316.             ASLFR_InitialDrawer&, CURDIR$, _
  317.             TAG_DONE&
  318.  
  319.     fr&=AllocAslRequest&(ASL_FileRequest&,VARPTR(frtags&(0)))
  320.     IF fr& THEN
  321.         DO
  322.             IF AslRequest&(fr&,0) THEN
  323.     ' a file name was entered to the file requester, so build the filename
  324.     ' from it and play the file
  325.                 filename$=PEEK$(PEEKL(fr&+fr_Drawer))
  326.                 IF RIGHT$(filename$,1)<>":" THEN
  327.                     filename$=filename$+"/"
  328.                 END IF
  329.                 filename$=filename$+PEEK$(PEEKL(fr&+fr_File))
  330.                 PlayFile filename$
  331.             ELSE
  332.                 EXIT LOOP
  333.             END IF
  334.         LOOP
  335.         FreeASlRequest fr&
  336.     END IF
  337. END IF
  338. CloseAudio
  339.